home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.06.lha / AmiCAD / ARexx / ImportTexte.AmiCAD < prev    next >
Text File  |  2000-04-13  |  3KB  |  118 lines
  1. /* Importation d'un texte dans une zone rectangulaire
  2.    26 avril 1998: version 1.00
  3.    3 Février 1999: version 1.01 (correction bug guillemets + gestion ligne)
  4.    21 février 1999: version 1.02 (modif appel REQFILE)
  5.    5 Janvier 2000: version 1.03 (utilisation GETZONE, traitement coupure lignes trop longues)
  6.    13 avril 2000: version 1.04 (adaptation version 205)
  7.    $VER: ImportTexte 1.04 (© R.Florac, 13 avril 2000)
  8.    Bug: ne gère pas les échelles et le mode placement courants */
  9.  
  10. options results
  11.  
  12. signal on error
  13. signal on syntax
  14.  
  15. xg=-1; xd=0; yh=0; yb=0
  16. 'FIRSTSEL'; obj=result
  17. if obj>0 then do
  18.     'TYPE('obj')'
  19.     if result=22 then do
  20.     'NEXTSEL('obj')'
  21.     if result=0 then do
  22.         'COORDS('obj')';
  23.         PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  24.         xg=minima(x0,x1); xd=maxima(x0,x1)
  25.         yh=minima(y0,y1); yb=maxima(y0,y1)
  26.     end
  27.     end
  28. end
  29.  
  30. if xg=-1 then do
  31.     'GETZONE("Dessinez la zone où placer le texte")'
  32.     z=result
  33.     if z="" then exit
  34.     PARSE VAR z x0 ',' y0 ',' x1 ',' y1
  35.     xg=minima(x0,x1); xd=maxima(x0,x1)
  36.     yh=minima(y0,y1); yb=maxima(y0,y1)
  37. end
  38.  
  39. 'REQFILE("Nom du fichier texte?", "Travail:texte/ASCII", "")'; fichier=result
  40. y0=yh
  41. if fichier ~= "" then do
  42.     if open(file, fichier, 'R') then do
  43.     y0=y0+10
  44.     'SAVEALL'
  45.     do while ~eof(file)
  46.         ligne=readln(file)
  47.         if ligne ~= "" then do
  48.         ligne=translate(ligne,"        ",'09'x)
  49.         ligne=doublage_guillemets(ligne)
  50.         t=words(ligne)
  51.         p=1
  52.         n=t
  53.         if t=1 then do        /* il y a un seul mot à écrire */
  54.             'WRITE("'ligne'",'xg','y0')'
  55.             call ligne_suivante
  56.         end
  57.         else
  58.         do while p<=t
  59.             mot=subword(ligne,p,n)
  60.             'TXWIDTH("'mot'")'
  61.             l=result
  62.             if l>=xd-xg then do
  63.             n=n-1
  64.             end
  65.             else do
  66.             'WRITE("'mot'",'xg','y0')'
  67.             call ligne_suivante
  68.             p=p+n
  69.             n=t-n
  70.             end
  71.         end
  72.         end
  73.     end
  74.     close(file)
  75.     end
  76. end
  77. exit
  78.  
  79. ligne_suivante:
  80.     y0=y0+10
  81.     if y0>=yb then do
  82.     'MESSAGE("Zone trop petite pour"+CHR(10)+"placer tout le texte")'
  83.     close(file)
  84.     exit
  85.     return
  86.  
  87. minima: procedure
  88.     parse arg v1,v2
  89.     if v1<v2 then return v1
  90.     return v2
  91. end
  92.  
  93. maxima: procedure
  94.     parse arg v1,v2
  95.     if v1>v2 then return v1
  96.     return v2
  97. end
  98.  
  99. doublage_guillemets: procedure
  100.     parse arg chaine
  101.     t=''
  102.     do i=1 to length(chaine)
  103.     c = substr(chaine,i,1)
  104.     if c='"' then c=c||'"'
  105.     t=t||c
  106.     end
  107.     return t
  108.  
  109. /* Traitement des erreurs, interruption du programme */
  110. syntax:
  111. erreur=RC
  112. 'MESSAGE("Script ImportTexte"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  113. exit
  114.  
  115. error:
  116. 'MESSAGE("Script ImportTexte"+CHR(10)+"Erreur en ligne 'SIGL'")'
  117. exit
  118.